100 REM MULTI-COLOUR SPRITE EDITOR
110 REM BY PAUL HIGGINBOTTOM
120 REM
130 IF LF=1 GOTO 6550
1000 V=13*4096:CR=13*4096+8*256
1005 C0=0:C1=1:C2=2:C3=3:C4=4:C5=5:C6=6:C7=7:C8=8:C9=9
1010 SC=1024:SD=SC+1016:PM=64:LL=40:SP=0:LL=40:MD=0
1020 POKE V+32,0:POKE V+33,0:POKE V+17,27+64:POKE V+37,2:POKE V+38,5
1030 FOR I=0 TO 7:POKE SD+I,192+I:POKE V+39+I,C8+I
1060 A(I)=C2^I:B(I)=255-A(I)
1070 NEXT
1080 POKE V+21,C0:POKE V+28,255
1090 FOR I=0 TO 3:C(I)=A(I*C2)+A(I*C2+C1):D(I)=255-C(I):E(I)=A(I*C2):NEXT
1210 MX=11:NX=12:MY=20:NY=21
1220 POKE 650,128:GOSUB 8100
1300 FOR I=0 TO 3:Q=I*C2:X(Q)=243:Y(Q)=70+I*30:X(Q+C1)=270:Y(Q+C1)=70+I*30:NEXT
1310 FOR SP=0 TO 7:GOSUB 7700:NEXT
1320 OPEN 1,8,15
1400 IP=20:REM INPUT POSITION
1410 IB$="                   ":REM INPUT BLANKING STRING
1900 POKE V+21,1:SP=0
2000 PRINT "[159][147]";
2010 FOR I=0 TO 20:PRINT SPC(24)"*":NEXT
2020 PRINT "************************"
2030 PRINT "COLOURS:  :  :  :[145]"
2090 FOR I=1 TO 3:Q=SC+925+I*C3:R=32+I*64:POKE Q,R:POKE Q+C1,R:NEXT
2100 GOSUB 9000
2120 PG=PEEK(SD+SP)
2130 P=PG*PM
2140 POKE 247,SP
2150 SYS MC
2600 PRINT "SPRITE    [157][157][157][157]"SP"[157], PAGE    [157][157][157][157]"PG
3000 R=SC+Y*LL+X*C2:T=PEEK(R)
3010 S=PEEK(R)
3020 S=(S+64)AND 255
3030 POKE R,S:POKE R+1,S
3040 FOR I=1 TO 25:GET A$:IF A$="" THEN NEXT:GOTO 3020
3050 POKE R,T:POKE R+1,T
3090 IF A$<>"" GOTO 3110
3100 X=X+C1+NX*(X=MX):IF X=C0 GOTO 3125
3105 GOTO 3000
3110 IF A$="[157]" THEN X=X-C1-NX*(X=C0):GOTO 3000
3120 IF A$<>"" GOTO 3130
3125 Y=Y+C1+NY*(Y=MY):GOTO 3000
3130 IF A$="[145]" THEN Y=Y-C1-NY*(Y=C0):GOTO 3000
3140 IF A$<"1" OR A$>"4" GOTO 3300
3150 C=VAL(A$)-C1
3160 R=P+Y*C3+X/C4:Q=PEEK(R):BP=C3-(X AND C3):Q=(Q AND D(BP)) OR C*E(BP)
3165 POKE R,Q
3170 R=SC+Y*LL+X*C2:C=C*64+32
3180 POKE R,C:POKE R+C1,C
3190 GOTO 3100
3300 IF A$<>"X" GOTO 3320
3310 Q=A(SP):W=PEEK(V+29):W=(W AND NOT Q) OR (NOT W AND Q):POKE V+29,W:GOTO3000
3320 IF A$<>"Y" GOTO 3340
3330 Q=A(SP):W=PEEK(V+23):W=(W AND NOT Q) OR (NOT W AND Q):POKE V+23,W:GOTO3000
3340 IF A$<>"+" GOTO 3370
3350 PG=PG+C1
3360 POKE SD+SP,PG:GOTO 2100
3370 IF A$="-" AND PG>192 THEN PG=PG-C1:GOTO 3360
3380 IF A$<>"N" GOTO 3390
3385 SP=(SP+C1) AND C7:GOTO 3400
3390 IF A$<>"P" GOTO 5000
3395 SP=(SP-C1) AND C7
3400 POKE V+21,PEEK(V+21) OR A(SP):GOTO 2100
5000 IF A$="[133]" THEN POKE V+33,(PEEK(V+33)+1)AND 15:GOTO 7000
5010 IF A$="[134]" THEN POKE V+37,(PEEK(V+37)+1)AND 15:GOTO 7000
5020 IF A$="[135]" THEN POKE V+39+SP,(PEEK(V+39+SP)+1)AND 15:GOTO 7000
5030 IF A$="[136]" THEN POKE V+38,(PEEK(V+38)+1)AND 15:GOTO 7000
5040 IF A$="[147]" THEN FOR I=0 TO 63:POKE P+I,0:NEXT:GOTO 2100
5050 IF A$="" THEN FOR I=0 TO 63:POKE P+64+I,PEEK(P+I):NEXT:GOTO 3350
5060 IF A$<>"C" GOTO 5100
5070 P$="TO WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
5080 IF Q=0 GOTO 7910
5090 FOR I=0 TO 63:POKE Q*64+I,PEEK(P+I):NEXT:PG=Q
5095 P$="NOW AT NEW PAGE":GOSUB 8400:GOTO 3360
5100 IF A$<>"	" GOTO 5130
5110 FOR I=P+60 TO P STEP -1:POKE I+C3,PEEK(I):NEXT
5120 FOR I=0 TO 2:POKE P+I,0:NEXT:GOTO 2100
5130 IF A$<>"" GOTO 5160
5140 FOR I=P+3 TO P+63:POKE I-C3,PEEK(I):NEXT
5150 FOR I=61 TO 63:POKE P+I,0:NEXT:GOTO 2100
5160 IF A$=";" THEN X(SP)=(X(SP)+C1) AND 511:GOSUB 7700:GOTO 3000
5170 IF A$=":" THEN X(SP)=(X(SP)-C1) AND 511:GOSUB 7700:GOTO 3000
5180 IF A$="@" THEN Y(SP)=(Y(SP)-C1) AND 255:GOSUB 7700:GOTO 3000
5190 IF A$="/" THEN Y(SP)=(Y(SP)+C1) AND 255:GOSUB 7700:GOTO 3000
6000 IF A$<>"S" GOTO 6500
6010 P$="FROM WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
6020 FP=Q:IF Q=0 GOTO 7910
6030 P$="TO WHICH PAGE?":GOSUB 8200:IF I$="" GOTO 3000
6040 LP=Q:IF Q=0 GOTO 7910
6045 IF LP<FP GOTO 7940
6050 P$="<D>ATA,<S>RC,<P>RG?":GOSUB 8200:IF I$="" GOTO 3000
6060 IF (I$<>"S") AND (I$<>"P") GOTO 7920
6065 IF I$="S" GOTO 6200
6070 GOSUB 8500:IF I$="" GOTO 3000
6080 OPEN 2,8,1,I$:GOSUB 7800:IF P$<>"OK" GOTO 7990
6085 P$="SAVING - WAIT":GOSUB 8400
6090 Q=FP*PM:PRINT#2,CHR$(Q-INT(Q/256)*256)CHR$(Q/256);
6100 FOR I=Q TO LP*PM+63:PRINT#2,CHR$(PEEK(I));:NEXT
6110 CLOSE2:P$="DONE":GOTO 7990
6200 GOSUB 8500:IF I$="" GOTO 3000
6210 OPEN 2,8,2,I$+",S,W":GOSUB 7800:IF P$<>"OK" GOTO 7990
6220 P$="WRITING SOURCE...":GOSUB 8400
6230 Q=FP*PM:C=LP*PM+63
6240 PRINT#2,";SPRITE DATA":PRINT#2,";"
6250 FOR I=Q TO C STEP 8:PRINT#2,".BYT ";
6260 FOR J=0 TO 7:PRINT#2,MID$(STR$(PEEK(I+J)),C2);:IF J<>C7 THEN PRINT#2,",";
6270 NEXT:PRINT#2:NEXT:PRINT#2,";":PRINT#2,".END":GOTO 6110
6500 IF A$<>"L" GOTO 6600
6510 GOSUB 8500:P$="LOADING - WAIT":GOSUB 8400
6540 LF=1:LOAD I$,8,1
6550 GOTO 2000
6600 IF A$="O" THEN POKE V+21,PEEK(V+21) AND B(SP):GOTO 3385
6900 GOTO 3000
7000 GOSUB 9000:GOTO 3000
7700 REM SET SPRITE POSITION
7710 POKE V+SP*C2,X(SP) AND 255:Q=PEEK(V+16) AND B(SP)
7720 IF X(SP)>255 THEN Q=Q OR A(SP)
7730 POKE V+16,Q:POKE V+SP*C2+C1,Y(SP)
7760 RETURN
7800 INPUT#1,A$,P$,A$,A$:RETURN
7900 REM ERROR OUT
7910 P$="LESS THAN 192":GOTO 7990
7920 P$="NOT IMPLEMENTED":GOTO 7990
7930 P$="SAY WHAT?":GOTO 7990
7940 P$="TO<FROM!":GOTO 7990
7990 GOSUB 8400:GOTO 3000
8000 DATA 169,0,133,248,133,251,169,4,133,249,166,247,189,248,7
8010 DATA 133,250,160,6,6,250,38,251,136,208,249,169,21,133,254
8020 DATA 169,0,133,253,164,253,192,3,208,27,24,165,248,105,16
8030 DATA 133,248,144,2,230,249,24,165,250,105,3,133,250,144,2
8040 DATA 230,251,198,254,208,220,96,177,250,133,247,169,3,133,252
8050 DATA 162,0,6,247,144,2,232,232,6,247,144,1,232,169,32
8060 DATA 224,0,240,6,24,105,64,202,208,250,160,0,145,248,200
8070 DATA 145,248,24,165,248,105,2,133,248,144,2,230,249,198,252
8080 DATA 16,209,230,253,208,164,-1
8100 MC=4*4096:M=MC:NE=-1
8102 READ A,B:IF PEEK(MC)=A AND PEEK(MC+C1)=B THEN RETURN
8105 RESTORE
8110 READ A:IF A<>NE THEN POKE M,A:M=M+C1:GOTO 8110
8120 RETURN
8200 REM INPUT ROUTINE
8210 GOSUB 8400:PRINT SPC(IP):I$=""
8220 F=0
8230 PRINT "*[157]";:GOTO 8250
8240 PRINT " [157]";
8250 FOR I=1 TO 30:GET A$:IF A$="" THEN NEXT:F=C1-F:ON F+C1 GOTO 8230,8240
8260 IF A$=CHR$(20) AND I$="" GOTO 8250
8270 IF A$=CHR$(20) THEN I$=LEFT$(I$,LEN(I$)-C1):PRINT A$;:GOTO 8220
8280 IF A$<>CHR$(13) GOTO 8320
8290 PRINT ""SPC(IP)IB$
8300 PRINT SPC(IP)IB$:Q=0:IF VAL(I$)>191 THEN Q=VAL(I$)
8310 RETURN
8320 IF A$<" " OR A$>"Z" GOTO 8220
8330 IF LEN(I$)<10 THEN I$=I$+A$:PRINT A$;
8340 GOTO 8220
8400 REM PROMPT
8410 PRINT ""SPC(IP)IB$:PRINT "[145]"SPC(IP)P$:RETURN
8500 REM INPUT FILENAME
8510 P$="FILENAME?":GOSUB 8200:RETURN
8999 END
9000 REM (null) SPRITE COLOURS INTO EXTENDED COLOUR MODE REGISTERS
9010 POKE V+34,PEEK(V+37)
9020 POKE V+35,PEEK(V+39+SP)
9030 POKE V+36,PEEK(V+38)
9040 RETURN